emg$ID = sub('.*(\\d{3}).*', '\\1', emg$Subject)
emg_sub =emg %>% select(Subject, ID, project, Stimulus,TAmplitudes,NumberOfTimesPresented, StimulusNumber) %>% unique() # to be added Q_LTE_di, Q_CTQ_di, Q_STAIT_sum, Q_BDI_sum
emg_sub$picNum<-str_sub(emg_sub$Stimulus,11,-1L)
emg_sub$Stimulus = NULL
emg_sub$ID = gsub("[^0-9.-]", "",emg_sub$ID)
emg_sub$ID = gsub("^0", "", emg_sub$ID)
emg_sub$ID = gsub("^0", "", emg_sub$ID)
# prep df_rat
df_rat$picNum<-str_sub(df_rat$picture,1,6)
df_rat$picture = NULL
df_rat_emg = merge(emg_sub, df_rat, by = c("ID", "project", "picNum"))
#detach(package:plyr) # if "sanity" is empty
sanity = df_rat_emg %>% group_by(Subject) %>% tally()
dfEMG<-df_rat_emg%>%select(ID,project, picNum,TAmplitudes,NumberOfTimesPresented,Category, StimulusNumber,arousal_rating, valence_rating)
# get old ID structure back, if needed
dfEMG$ID <- paste(dfEMG$project ,dfEMG$ID , sep = "_")
dfEMG$project = NULL
emg_rat = dfEMG
# new: n = 401
hist(as.numeric(dfEMG$arousal_rating))
hist(as.numeric(dfEMG$valence_rating))
STR_Valence_RSM
the Nearest Neighborhood model which assumes that the closer trials
are in valence, the more similar they are
from the Anna Karenina (AK) model which assumes that trials with high
valence will be more similar to each other than those rates as low
arousal, we will derive the inverted model (Inverted AK Model), which
assumes that lower values of valence are similar to each other, but
higher values are more dissimilar
Behav_Single_STR_Valence_RSM
Behav_Single_STR_AK_Valence_RSM
Behav_Single_STR_invAK_Valence_RSM
ValRatingsNN_STRSingle_IndividualPlot
ValRatingsAK_STRSingle_IndividualPlot
ValRatingsinvAK_STRSingle_IndividualPlot
ggarrange( STR_ValRatingsNN_PermOutput[["Output"]][["PermutationPlot"]],
STR_ValRatingsAK_PermOutput[["Output"]][["PermutationPlot"]],
STR_ValRatingsinvAK_PermOutput[["Output"]][["PermutationPlot"]],
labels = c("NN", "AK", "invAK" ), hjust=-2,
ncol = 1, nrow =3, widths = c(10,10))
#Combine two histograms in one
p1<-matrix(unlist(STR_ValRatingsAK_PermOutput[["PermutationTest"]][["value"]]), ncol=1)
p2<-matrix(unlist(STR_ValRatingsNN_PermOutput[["PermutationTest"]][["value"]]), ncol=1)
p1<-tibble(p1)
p2<-tibble(p2)
p1$model<-"AK"
p2$model<-"NN"
names(p1)<-c("permutation","model")
names(p2)<- c("permutation","model")
ptotal<-rbind(p1,p2)
similarity1<-matrix(unlist(STR_ValRatingsAK_PermOutput[["Similarity"]]),ncol=1)
similarity2<-matrix(unlist(STR_ValRatingsNN_PermOutput[["Similarity"]]),ncol=1)
similarity1$model<-"AK"
## Warning in similarity1$model <- "AK": Coercing LHS to a list
similarity2$model<-"NN"
## Warning in similarity2$model <- "NN": Coercing LHS to a list
names(similarity1)<-c("Similarity","model")
names(similarity2)<- c("Similarity","model")
similaritytotal<-as.data.frame(rbind(similarity1,similarity2))
similaritytotal$Similarity<-as.numeric(similaritytotal$Similarity)
#similaritytotal$model<-as.factor(similaritytotal$model)
th1<-matrix(unlist(STR_ValRatingsAK_PermOutput[["PermutationTest"]][["value"]][9500]), ncol=1)
th2<-matrix(unlist(STR_ValRatingsNN_PermOutput[["PermutationTest"]][["value"]][9500]), ncol=1)
th1<-tibble(th1)
th2<-tibble(th2)
th1$model<-"AK"
th2$model<-"NN"
names(th1)<-c("threshold","model")
names(th2)<- c("threshold","model")
thtotal<-rbind(th1,th2)
test<-
ggplot(ptotal, aes(permutation, fill = model)) +
geom_density(alpha = 0.55,
size = 1)+ scale_fill_manual(values=c('darkgoldenrod1','darkmagenta'))+
scale_y_continuous(expand = expansion(mult = c(0, .1)))
den1 = test+geom_vline(data=similaritytotal, aes(xintercept=Similarity),
color= c('darkgoldenrod1','darkmagenta'), linetype="solid",size = 2)+
geom_vline(data=thtotal, aes(xintercept=threshold),
color= c('darkgoldenrod1','darkmagenta'), linetype="dashed",size = 2)+
theme_classic()+
theme(axis.text.x= element_text(size=15),
axis.text.y= element_text(size=15),
axis.title.x = element_blank(),
axis.title.y = element_text( size=15,face="bold"),
legend.position = "none",
text=element_text(family="Times New Roman"))+
labs(y= "Density")
den1
#RSMs combined
SCR<-STR_corr_prep_all%>% select(var1, var2, mean_all)
SCR$Similarity<-SCR$mean_all
invAK<- Behav_Single_STR_AK_corr_prep_all%>% select(var1, var2, mean_all)
invAK$Similarity<-invAK$mean_all
NN<- Behav_Single_STR_corr_prep_all%>% select(var1, var2, mean_all)
NN$Similarity<-NN$mean_all
SCRDown<-SCR%>% filter(var1<var2)
invAKUp<- invAK%>% filter(var1>var2)
NNUp<- NN%>%filter(var1>var2)
invAKSCR<- rbind(SCRDown,invAKUp)
NNSCR<- rbind(SCRDown, NNUp)
library(ggnewscale)
dataOriginal<-invAKSCR#data coming up from RSM functions it should contain the variable mean_all
mypalette<- numeric()#colors
minimum<-numeric()#scale
maximum<-numeric()# scale
Category<- "trials" # VP or trials
Participant<- "Similarity" # factor() #if individual participants are to be selected,
sortType<- "Valence" #variable to sort on
mat_plot_AK = PlotMatrixCombined(dataOriginal, minimum,maximum,Category,sortType,Participant, mypalette)
## Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
## ℹ Please use `all_of()` or `any_of()` instead.
## # Was:
## data %>% select(Participant)
##
## # Now:
## data %>% select(all_of(Participant))
##
## See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.
mat_plot_AK2 = mat_plot_AK+ theme(legend.position = "none",
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
title = element_blank())
dataOriginal<-NNSCR#data coming up from RSM functions it should contain the variable mean_all
mypalette<- numeric()#colors
minimum<-numeric()#scale
maximum<-numeric()# scale
Category<- "trials" # VP or trials
Participant<- "Similarity" # factor() #if individual participants are to be selected,
sortType<- "Valence" #variable to sort on
mat_plot_NN = PlotMatrixCombined(dataOriginal, minimum,maximum,Category,sortType,Participant, mypalette)
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.
mat_plot_NN2 = mat_plot_NN + theme(legend.position = "none",
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
title = element_blank())
#Plot individual Data
library(ggridges) # ridgeline plot
library(tidyr) # long format
library(colorBlindness)
library(RColorBrewer)
test = cbind(ValRatingsAK_STRSingle_tableCorrelation,
ValRatingsNN_STRSingle_tableCorrelation)
test2 = test[c(1,2,4)]
names(test2)<-c("VP", "AK", "NN")
long_data2 <- gather(test2, key = "model", value = "Similarity", 2:3)
ggplot(long_data2, aes(x=Similarity, y=model, fill = model)) + geom_density_ridges()+
scale_fill_brewer(palette = 4) +
theme_ridges() + theme(legend.position = "none")+
labs(x = "rho value", y = "Regressor")+
geom_vline(xintercept = 0, color = "red", linetype = "dashed")
## Picking joint bandwidth of 0.023
# colorblind friendly
cols = c( 'darkgoldenrod1','darkmagenta')
# "#004949" , "#009292" , "#FF6DB6" , "#FFB6DB" , "#490092" , "#006DDB" ,
# "#B66DFF" , "#6DB6FF" , "#B6DBFF")
den2 = ggplot(long_data2, aes(x=Similarity, y=model, fill = model, alpha = .2)) +
theme_classic() + theme(legend.position = "none")+
labs(x = "Similarity", y = "")+
scale_y_discrete(expand = expansion(add = c(0,1)))+
geom_density_ridges(
quantile_lines=TRUE,
bandwidth = 0.1,
quantile_fun=function(x,...)mean(x),
size = 1
) +
scale_fill_manual(values = cols, )+
geom_vline(xintercept = 0, color = "black", linetype = "dashed", size = 1)+
scale_x_continuous(breaks= c(-.6,-.2,-.4,0, .2,.4,.6,.8), limits= c(-.6,.8))+
theme(axis.text.x= element_text(size=15),
axis.text.y= element_blank(), #element_text(size=15),
axis.title.x = element_text( size=15,face="bold"),
axis.title.y = element_text( size=15,face="bold"),
text=element_text(family="Times New Roman"))+
labs(x = "Similarity Index", y = "Models")
den2
## Warning: Using the `size` aesthietic with geom_segment was deprecated in ggplot2 3.4.0.
## ℹ Please use the `linewidth` aesthetic instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
library(patchwork)
mat_plot_AK2+ den1+ mat_plot_NN2 + den2+ plot_annotation(tag_levels = list(c("A", "C", "B", "D"))) &
theme(plot.tag = element_text(size = 25, face = "bold"))
ggarrange(STR_Single_ValRatings_AK_ValRatings_NN_IndividualPlotRegression[[1]],
STR_Single_ValRatings_AK_ValRatings_NN_IndividualPlotRegression[[2]],
labels = c("", "" ), vjust=-7,
ncol = 2, nrow =1, widths = c(5,5))
ggarrange(STR_Single_ValRatings_AK_ValRatings_NN_PermOutputRegr[["Ouput"]][["RSMPlotRegressionM1"]],
STR_Single_ValRatings_AK_ValRatings_NN_PermOutputRegr[["Ouput"]][["RSMPlotRegressionM2"]],
labels = c("", "" ), vjust=-7,
ncol = 2, nrow =1, widths = c(5,5))
ggarrange( STR_Single_ValRatings_AK_ValRatings_NN_PermOutputRegr[["Ouput"]][["PermutationPlotM1"]],
STR_Single_ValRatings_AK_ValRatings_NN_PermOutputRegr[["Ouput"]][["PermutationPlotM2"]],
labels = c("AK", "NN"), vjust=(12),
ncol = 1, nrow =2, widths = c(5,5))
### new plot for regression
# 3.11.23
#Combine two histograms in one
p1<-matrix(unlist(STR_Single_ValRatings_AK_ValRatings_NN_PermOutputRegr[["Model1"]][["PermutationTest"]][["value"]]), ncol=1)
p2<-matrix(unlist(STR_Single_ValRatings_AK_ValRatings_NN_PermOutputRegr[["Model2"]][["PermutationTest"]][["value"]]), ncol=1)
p1<-tibble(p1)
p2<-tibble(p2)
p1$model<-"AK"
p2$model<-"NN"
names(p1)<-c("permutation","model")
names(p2)<- c("permutation","model")
ptotal<-rbind(p1,p2)
similarity1<-matrix(unlist(STR_Single_ValRatings_AK_ValRatings_NN_PermOutputRegr[["Model1"]][["Similarity"]]),ncol=1)
similarity2<-matrix(unlist(STR_Single_ValRatings_AK_ValRatings_NN_PermOutputRegr[["Model2"]][["Similarity"]]),ncol=1)
similarity1$model<-"AK"
## Warning in similarity1$model <- "AK": Coercing LHS to a list
similarity2$model<-"NN"
## Warning in similarity2$model <- "NN": Coercing LHS to a list
names(similarity1)<-c("Similarity","model")
names(similarity2)<- c("Similarity","model")
similaritytotal<-as.data.frame(rbind(similarity1,similarity2))
similaritytotal$Similarity<-as.numeric(similaritytotal$Similarity)
#similaritytotal$model<-as.factor(similaritytotal$model)
th1<-matrix(unlist(STR_Single_ValRatings_AK_ValRatings_NN_PermOutputRegr[["Model1"]][["PermutationTest"]][["value"]][9500]), ncol=1)
th2<-matrix(unlist(STR_Single_ValRatings_AK_ValRatings_NN_PermOutputRegr[["Model2"]][["PermutationTest"]][["value"]][9500]), ncol=1)
th1<-tibble(th1)
th2<-tibble(th2)
th1$model<-"AK"
th2$model<-"NN"
names(th1)<-c("threshold","model")
names(th2)<- c("threshold","model")
thtotal<-rbind(th1,th2)
test<-
ggplot(ptotal, aes(permutation, fill = model)) + geom_density(alpha = 0.55,
size = 1)+ scale_fill_manual(values=c('darkgoldenrod1','darkmagenta'))+
scale_y_continuous(expand = expansion(mult = c(0, .1)))
den3 = test+geom_vline(data=similaritytotal, aes(xintercept=Similarity),
color= c('darkgoldenrod1','darkmagenta'), linetype="solid",size = 2)+
geom_vline(data=thtotal, aes(xintercept=threshold),
color= c('darkgoldenrod1','darkmagenta'), linetype="dashed",size = 2)+
theme_classic()+
theme(axis.text.x= element_text(size=15),
axis.text.y= element_text(size=15),
axis.title.x = element_blank(),
axis.title.y = element_text( size=15,face="bold"),
legend.position = "none",
text=element_text(family="Times New Roman"))+
labs(y = "Density")
#RSMs combined
SCR<-STR_corr_prep_all%>% select(var1, var2, mean_all)
SCR$Similarity<-SCR$mean_all
invAK<- STR_Single_ValRatings_AK_ValRatings_NN_PermOutputRegr[["Ouput"]][["RSMPlotRegressionM1"]][["data"]]%>% select(var1, var2, mean_all)
invAK$Similarity<-invAK$mean_all
NN<- STR_Single_ValRatings_AK_ValRatings_NN_PermOutputRegr[["Ouput"]][["RSMPlotRegressionM2"]][["data"]]%>% select(var1, var2, mean_all)
NN$Similarity<-NN$mean_all
SCRDown<-SCR%>% filter(var1<var2)
invAKUp<- invAK%>% filter(var1>var2)
NNUp<- NN%>%filter(var1>var2)
invAKSCR<- rbind(SCRDown,invAKUp)
NNSCR<- rbind(SCRDown, NNUp)
library(ggnewscale)
dataOriginal<-invAKSCR#data coming up from RSM functions it should contain the variable mean_all
mypalette<- numeric()#colors
minimum<-numeric()#scale
maximum<-numeric()# scale
Category<- "trials" # VP or trials
Participant<- "Similarity" # factor() #if individual participants are to be selected,
sortType<- "Valence" #variable to sort on
mat_3 =PlotMatrixCombined(dataOriginal, minimum,maximum,Category,sortType,Participant, mypalette)
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.
mat_plot_AK3 = mat_3 + theme(legend.position = "none",
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
title = element_blank())
dataOriginal<-NNSCR#data coming up from RSM functions it should contain the variable mean_all
mypalette<- numeric()#colors
minimum<-numeric()#scale
maximum<-numeric()# scale
Category<- "trials" # VP or trials
Participant<- "Similarity" # factor() #if individual participants are to be selected,
sortType<- "Valence" #variable to sort on
mat4 = PlotMatrixCombined(dataOriginal, minimum,maximum,Category,sortType,Participant, mypalette)
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.
mat_plot_NN3 = mat4 + theme(legend.position = "none",
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
title = element_blank())
#Plot individual Data
library(ggridges) # ridgeline plot
library(tidyr) # long format
library(colorBlindness)
library(RColorBrewer)
test2 = STR_Single_ValRatings_AK_ValRatings_NN_tableRegression #SCR_Single_AroRatings_invAK_AroRatings_NN_tableRegression
names(test2)<-c("VP", "AK", "NN")
long_data2 <- gather(test2, key = "model", value = "Similarity", 2:3)
# colorblind friendly
cols = c( 'darkgoldenrod1','darkmagenta')
# "#004949" , "#009292" , "#FF6DB6" , "#FFB6DB" , "#490092" , "#006DDB" ,
# "#B66DFF" , "#6DB6FF" , "#B6DBFF")
den4 = ggplot(long_data2, aes(x=Similarity, y=model, fill = model, alpha = .2)) +
theme_classic() + theme(legend.position = "none")+
labs(x = "Similarity", y = "")+
scale_y_discrete(expand = expansion(add = c(0,1)))+
geom_density_ridges(quantile_lines=TRUE,bandwidth = 0.1,
quantile_fun=function(x,...)mean(x), size = 1) +
scale_fill_manual(values = cols, )+
geom_vline(xintercept = 0, color = "black", linetype = "dashed", size = 1)+
scale_x_continuous(breaks= c(-.6,-.4,-.2,0,.2,.4,.6,.8), limits= c(-.65,.85))+
theme(axis.text.x= element_text(size=15),
axis.text.y= element_blank(), #element_text(size=15),
axis.title.x = element_text( size=15,face="bold"),
axis.title.y = element_text( size=15,face="bold"),
text=element_text(family="Times New Roman"))+
labs(x = "Similarity Index", y = "Models")
den4
library(patchwork)
mat_plot_AK3+ den3+ mat_plot_NN3 + den4+ plot_annotation(tag_levels = list(c("A", "C", "B", "D"))) &
theme(plot.tag = element_text(size = 25, face = "bold"))
STRCorrModComp
### Plot individual participants as example:
#Plot VP
#-------------- Plot RSM Matrix
dataOriginal<-STR_corr_prep_all#data coming up from RSM functions it should contain the variable mean_all
mypalette<- numeric()#colors
minimum<-numeric()#scale
maximum<-numeric()# scale
Category<- "trials" # VP or trials
Participant<- "VP3Z02_1" # factor() #if individual participants are to be selected,
sortType<- "Valence" #variable to sort on
PlotMatrix(dataOriginal, minimum,maximum,Category,sortType,Participant, mypalette)
#Plot VP
dataOriginal<-STR_corr_prep_all#data coming up from RSM functions it should contain the variable mean_all
mypalette<- numeric()#colors
minimum<-numeric()#scale
maximum<-numeric()# scale
Category<- "trials" # VP or trials
Participant<- "VP3Z02_68" # factor() #if individual participants are to be selected,
sortType<- "Valence" #variable to sort on
PlotMatrix(dataOriginal, minimum,maximum,Category,sortType,Participant, mypalette)
#Plot VP
dataOriginal<-STR_corr_prep_all#data coming up from RSM functions it should contain the variable mean_all
mypalette<- numeric()#colors
minimum<-numeric()#scale
maximum<-numeric()# scale
Category<- "trials" # VP or trials
Participant<- "VP3Z02_18" # factor() #if individual participants are to be selected,
sortType<- "Valence" #variable to sort on
PlotMatrix(dataOriginal, minimum,maximum,Category,sortType,Participant, mypalette)
STR_TimeSortedByValence_IndividualPlot
SCRSingleCorrModCompTime
ggarrange(STR_Val_AK_Time_NN_IndividualPlotRegression[[1]],
STR_Val_AK_Time_NN_IndividualPlotRegression[[2]],
labels = c("", "" ), vjust=-7,
ncol = 2, nrow =1, widths = c(5,5))
STRSingle_Categorysortedbyvalence_IndividualPlot
SCRSingleCorrModCompCat
ggarrange(STRSingle_Valence_AK_Category_Factor_IndividualPlotRegression[[1]],
STRSingle_Valence_AK_Category_Factor_IndividualPlotRegression[[2]],
labels = c("", "" ), vjust=-7,
ncol = 2, nrow =1, widths = c(5,5))
STRSingle_AroSortedByValence_IndividualPlot
SCRSingleCorrModCompVal
ggarrange(STR_Valence_AK_Arousal_NN_IndividualPlotRegression[[1]],
STR_Valence_AK_Arousal_NN_IndividualPlotRegression[[2]],
labels = c("", "" ), vjust=-7,
ncol = 2, nrow =1, widths = c(5,5))
STR_Category2SortedbyValence_IndividualPlot
### Test whether the AK model is contributing beyond Category 2
SCRSingleCorrModCompCat2
ggarrange(STR_Valence_AK_Category2_Factor_IndividualPlotRegression[[1]],
STR_Valence_AK_Category2_Factor_IndividualPlotRegression[[2]],
labels = c("", "" ), vjust=-7,
ncol = 2, nrow =1, widths = c(5,5))
#save.image("RSA_STR_Sound_VB22_Def.RData")
library(ggridges) # ridgeline plot
library(tidyr) # long format
library(colorBlindness)
library(RColorBrewer)
#install.packages("cols4all", dependencies = TRUE)
#library(cols4all)
long_data <- gather(SingleSimComparisonCat2, key = "model", value = "Correlation", 2:3)
ggplot(long_data, aes(x=Correlation, y=model)) + geom_density_ridges()
## Picking joint bandwidth of 0.0237
### single model alternative based on RSM data
#STR_VariableModel1_VariableModel2_tableRegression = tableCorrelation
# long_data2 <- gather(STR_VariableModel1_VariableModel2_tableRegression, key = "model", value = "Similarity", 2:3)
# ggplot(long_data2, aes(x=Similarity, y=model)) + geom_density_ridges()+
# scale_y_discrete(labels = c(VariableModel1, VariableModel2))
### all models
# test = cbind(STR_Val_AK_Time_NN_tableRegression,
# STR_Valence_AK_Arousal_NN_tableRegression,
# STR_Valence_AK_Category2_Factor_tableRegression,
# STR_Single_ValRatings_AK_ValRatings_NN_tableRegression,
# STRSingle_Valence_AK_Category_Factor_tableRegression)
# test2 = test[-c(4,7,10,13)]
test = cbind(STR_Val_AK_Time_NN_tableRegression,
STRSingle_Valence_AK_Category_Factor_tableRegression,
STR_Valence_AK_Category2_Factor_tableRegression,
STR_Valence_AK_Arousal_NN_tableRegression)
#test2 = test[c(1,3,6,9,12)]#
test2 = test[c(1,2,5,8, 11 )]
names(test2)<-c("VP", "Time", "Cat", "Cat2", "Arousal")
long_data2 <- gather(test2, key = "regressor", value = "rho value", 2:5)
ggplot(long_data2, aes(x= `rho value`, y=regressor, fill = regressor)) + geom_density_ridges()+
geom_density_ridges(quantile_lines=TRUE,
quantile_fun=function(x,...)mean(x), color = "white") +
scale_fill_brewer(palette = 4) +
theme_ridges() + theme(legend.position = "none")+
geom_vline(xintercept = 0, color = "red",size = 1.5, linetype = "dashed")
## Picking joint bandwidth of 0.0296
## Picking joint bandwidth of 0.0296
# colorblind friendly
cols = c("#E69F00" , "#004949" , "#009292" , "#FF6DB6" , "#FFB6DB" , "#490092" , "#006DDB" ,
"#B66DFF" , "#6DB6FF" , "#B6DBFF")
ggplot(long_data2, aes(x= `rho value`, y=regressor, fill = regressor)) + geom_density_ridges()+ geom_density_ridges(quantile_lines=TRUE,
quantile_fun=function(x,...)mean(x), color = "black") +
theme_ridges() + theme(legend.position = "none")+
scale_fill_manual(values = cols)+
geom_vline(xintercept = 0, color = "red", size = 1.5, linetype = "dashed")
## Picking joint bandwidth of 0.0296
## Picking joint bandwidth of 0.0296
#displayAvailablePalette(color="white")
#FINAL GRAPH
cols = c( "#6DB6FF" , "#004949" , "#FFB6DB","#B66DFF" )
ggplot(long_data2, aes(x= `rho value`, y=regressor, fill = regressor, alpha = .2)) +
theme_classic() + theme(legend.position = "none")+
labs(x = "Similarity", y = "")+
scale_y_discrete(expand = expansion(add = c(0,1)))+
geom_density_ridges(quantile_lines=TRUE,bandwidth = 0.1,
quantile_fun=function(x,...)mean(x), size = 1) +
scale_fill_manual(values = cols, )+
geom_vline(xintercept = 0, color = "black", linetype = "dashed", size = 1)+
scale_x_continuous(breaks= c(-.5,-.25,0, .25,.5,.75), limits= c(-.5,.8))+
theme(axis.text.x= element_text(size=20),
axis.text.y= element_blank(), #element_text(size=15),
axis.title.x = element_text( size=25,face="bold"),
axis.title.y = element_text( size=15,face="bold"),
title = element_text(face = "bold", size = 20 ),
text=element_text(family="Times New Roman"))+
labs(tag = "A", title = "PPV from discovery sample")
library(dendextend)
##
## ---------------------
## Welcome to dendextend version 1.16.0
## Type citation('dendextend') for how to cite the package.
##
## Type browseVignettes(package = 'dendextend') for the package vignette.
## The github page is: https://github.com/talgalili/dendextend/
##
## Suggestions and bug-reports can be submitted at: https://github.com/talgalili/dendextend/issues
## You may ask questions at stackoverflow, use the r and dendextend tags:
## https://stackoverflow.com/questions/tagged/dendextend
##
## To suppress this message use: suppressPackageStartupMessages(library(dendextend))
## ---------------------
##
## Attaching package: 'dendextend'
## The following object is masked from 'package:ggpubr':
##
## rotate
## The following object is masked from 'package:stats':
##
## cutree
library(circlize)
## ========================================
## circlize version 0.4.15
## CRAN page: https://cran.r-project.org/package=circlize
## Github page: https://github.com/jokergoo/circlize
## Documentation: https://jokergoo.github.io/circlize_book/book/
##
## If you use it in published research, please cite:
## Gu, Z. circlize implements and enhances circular visualization
## in R. Bioinformatics 2014.
##
## This message can be suppressed by:
## suppressPackageStartupMessages(library(circlize))
## ========================================
my_data = Behav_Single_STR_AK_corr_prep_all
# Select the columns for clustering
data_for_clustering <- my_data[, c("var1", "var2", "mean_all")]
# Perform hierarchical clustering
dist_matrix <- dist(data_for_clustering) # Calculate the distance matrix
hc <- hclust(dist_matrix) # Perform hierarchical clustering
# Plot the dendrogram
#plot(hc, main = "Dendrogram of Clustering")
# Convert hierarchical clustering object to a dendrogram
dendro <- as.dendrogram(hc)
dendro <- dendro %>%
color_branches(k=4) %>%
color_labels
plot(dendro)
# Create a circular dendrogram
# plot the radial plot
par(mar = rep(0,4))
# circlize_dendrogram(dend, dend_track_height = 0.8)
circlize_dendrogram(dendro, labels_track_height = NA, dend_track_height = .4)